home *** CD-ROM | disk | FTP | other *** search
/ The X-Philes (2nd Revision) / The X-Philes Number 1 (1995).iso / xphiles / hp48hor2 / rplxmpl9.dir < prev    next >
File List  |  1994-01-04  |  17KB  |  1,108 lines
  1. %%HP: T(3)A(D)F(.);
  2. DIR
  3.   SETUP
  4.     \<< CCD \->RPL EVAL
  5.     \>>
  6.   Cst
  7. C$ 1169 (Cst)
  8. {
  9.  ROMPTR 4D2 0 (RPL\->)
  10.  ROMPTR 4D2 1 (\->RPL)
  11.  {
  12.   ::
  13.    TakeOver
  14.    $ "5/7" 63
  15.    TestUserFlag
  16.    Box/StdLabel
  17.   ;
  18.   ::
  19.    TakeOver
  20.    63 DUP TestUserFlag
  21.    ITE
  22.     ClrUserFlag
  23.     SetUserFlag
  24.   ;
  25.  }
  26.  {
  27.   ::
  28.    TakeOver
  29.    $ "Disassembler On/Off"
  30.    DROP
  31.    4 SysITE
  32.     GROB 3A 8000051000000000FFFFF118B30114440114550114440118B301FFFFF1
  33.     GROB 3A 8000051000000000FFFFF11000011000011000011CB701100001FFFFF1
  34.   ;
  35.   :: PTR 3ED84 4
  36.      SetDA12NoCh
  37.   ;
  38.  }
  39.  {
  40.   ::
  41.    TakeOver
  42.    $ "S-ED" 61
  43.    TestUserFlag
  44.    Box/StdLabel
  45.   ;
  46.   ::
  47.    TakeOver
  48.    61 DUP TestUserFlag
  49.    ITE
  50.     ClrUserFlag
  51.     SetUserFlag
  52.    SetDA12NoCh
  53.   ;
  54.  }
  55.  ROMPTR 4D2 5 (\->OB)
  56.  { $ "EC"
  57.  :: TakeOver
  58.     ROMPTR 4D2 C (EC)
  59.  ; }
  60.  ROMPTR 4C5 20 (PGLIB)
  61.  {
  62.   $ "SEND"
  63.   ::
  64.    CK1NoBlame
  65.    BlankDA12
  66.    xSEND
  67.    xKERRM
  68.    xCLOSEIO
  69.    %0 InitMenu%
  70.    DUPNULL$? caseDROP
  71.   ;
  72.  }
  73.  {
  74.   $ "RECV"
  75.   ::
  76.    AtUserStack
  77.    BlankDA12
  78.    xRECV
  79.    xKERRM
  80.    xCLOSEIO
  81.    %0 InitMenu%
  82.    DUPNULL$? caseDROP
  83.   ;
  84.  }
  85.  {
  86.   :: PTR 3ECD0
  87.      $ "RPRT" 13
  88.   ;
  89.   :: PTR 3ED84 13
  90.      SetDA12NoCh
  91.   ;
  92.  }
  93.  {
  94.   $ "CF1-8"
  95.   ::
  96.    TakeOver
  97.    8
  98.    #1+_ONE_DO
  99.     INDEX@ ClrUserFlag
  100.    LOOP
  101.    SetDA2NoCh
  102.    SetDA3NoCh
  103.   ;
  104.  }
  105. }
  106.   LIBMENU
  107. C$ 1675 (LIBMENU)
  108. {
  109.  $ "\\<-LIB\\->"
  110.  ::
  111.   MenuMaker
  112.   ::
  113.    PTR 3F036 PTR 3EFE6
  114.    {
  115.     { $ "\\->OB\\->"
  116.      :: TakeOver
  117.       {
  118.        ROMPTR 4C5 5 (OB\->)
  119.        ROMPTR 4C5 6 (\->DIR)
  120.        ROMPTR 4C5 7 (\->PRG)
  121.        ROMPTR 4C5 8 (\->XLIB)
  122.        ROMPTR 4C5 9 (\->ARR)
  123.        ROMPTR 4C5 A (\->ALG)
  124.        ROMPTR 4C5 B (\->LD)
  125.        ROMPTR 4C5 C (\->BAK)
  126.        ROMPTR 4C5 D (\->ID)
  127.       }
  128.       InitMenu
  129.      ;
  130.     }
  131.     { $ "\\->LIB\\->"
  132.      :: TakeOver
  133.       {
  134.        ROMPTR 4C5 0 (D\->LIB)
  135.        ROMPTR 4C5 1 (L\->DIR)
  136.        ROMPTR 4C5 2 (MCFG)
  137.        ROMPTR 4C5 3 (ML\->D)
  138.        ROMPTR 4C5 4 (MD\->L)
  139.       }
  140.       InitMenu
  141.      ;
  142.     }
  143.     { $ "VARS"
  144.      :: TakeOver
  145.       {
  146.        ROMPTR 4C5 F ($romid)
  147.        ROMPTR 4C5 10 ($visible)
  148.        ROMPTR 4C5 11 ($title)
  149.        ROMPTR 4C5 12 ($config)
  150.        ROMPTR 4C5 13 ($vars)
  151.        ROMPTR 4C5 14 ($hidden)
  152.        ROMPTR 4C5 15 ($message)
  153.       }
  154.       InitMenu
  155.      ;
  156.     }
  157.     { $ "RCL"
  158.      :: TakeOver
  159.       {
  160.        ROMPTR 4C5 1F (RLIB)
  161.        ROMPTR 4C5 1D (RTITLE)
  162.        ROMPTR 4C5 1B (RCFG)
  163.        ROMPTR 4C5 1C (RMSG)
  164.        ROMPTR 4C5 1A (RLINK)
  165.        ROMPTR 4C5 19 (RHASH)
  166.        ROMPTR 4C5 1E (RPORT)
  167.       }
  168.       InitMenu
  169.      ;
  170.     }
  171.     { $ "TOOLS"
  172.      :: TakeOver
  173.       {
  174.        ROMPTR 4C5 16 (LBCRC)
  175.        ROMPTR 4C5 17 (RNLIB)
  176.        ROMPTR 4C5 18 (CHLID)
  177.        ROMPTR 4C5 E (ADRp)
  178.        ROMPTR 4C5 26 (fEVAL)
  179.       }
  180.       InitMenu
  181.      ;
  182.     }
  183.     { $ "CTRL"
  184.      :: TakeOver
  185.       {
  186.        ROMPTR 4C5 21 (STLIB)
  187.        ROMPTR 4C5 22 (ACLIB)
  188.        ROMPTR 4C5 20 (PGLIB)
  189.        ROMPTR 4C5 25 (LIBSp)
  190.        ROMPTR 4C5 24 (INSTp)
  191.        ROMPTR 4C5 23 (LIBp)
  192.       }
  193.       InitMenu
  194.      ;
  195.     }
  196.    }
  197.   ;
  198.   PTR 40DC0
  199.  ;
  200. }
  201.   \->Rpl
  202. C$ 538 (\->Rpl,$ \-> o)
  203. ASSEMBLE
  204. EvalNoCK: EQU #18F6A
  205. RPL
  206. ::
  207.  CK1NoBlame
  208.  BEGIN
  209.   1LAMBIND
  210.   ERRSET
  211.   ::
  212.    1GETLAM
  213.    ROMPTR 4D2 1 (\->RPL)
  214.    TRUE
  215.   ;
  216.   ERRTRAP
  217.   :: DropSysObs FALSE
  218.   ;
  219.   1GETABND SWAP
  220.   ITE
  221.    DROPTRUE
  222.   ::
  223.    ERROR@
  224.    DUP#0=csedrp TRUE
  225.    DUP GETTHEMESG SWAP
  226.    # 70000 #=case
  227.    ::
  228.     DUP DISPSTATUS2
  229.     DUPUNROT
  230.     SEP$NL SWAPDROP
  231.     DUP $ ":" OVERLEN$
  232.     POS$REV #1+
  233.     OVERLEN$ SUB$
  234.     DOSTR> TWO{}N
  235.     EvalNoCK: xINPUT
  236.     FALSE
  237.    ;
  238.    $ "\\->RPL Error:\\010"
  239.    SWAP&$ DISPSTATUS2
  240.    SetDA1Temp
  241.    TRUE
  242.   ;
  243.  UNTIL
  244. ;
  245.   DCD
  246. C$ 521 (DCD,d \-> d')
  247. ::
  248.  CK1NoBlame
  249.  DUPTYPERRP? NcaseTYPEERR
  250.  ROMPTR 4C5 5 (OB\->)
  251.  COERCE
  252.  DUP#0=case SETSIZEERR
  253.  DUP #2* 1LAMBIND
  254.  BlankDA2
  255.  $ "Processing:\\010"
  256.  DISPSTATUS2
  257.  #1+_ONE_DO
  258.   1GETLAM ROLL
  259.   1GETLAM ROLL
  260.   DUP ID>$ DISPROW2
  261.   SWAP
  262.   ::
  263.    DUPTYPERRP? ?SEMI
  264.    XEQTYPE %25 %=
  265.    ITE
  266.    ::
  267.     ROMPTR 4D2 3 (COD\->)
  268.     OVER ID>$ CHR_*
  269.    ;
  270.    ::
  271.     ROMPTR 4D2 0 (RPL\->)
  272.     OVER ID>$
  273.     CHR_RightPar >T$
  274.     CHR_LeftPar
  275.    ;
  276.    >H$ NEWLINE$&$
  277.    !insert$
  278.   ;
  279.   SWAP
  280.  LOOP
  281.  1GETABND #2/
  282.  UNCOERCE
  283.  ROMPTR 4C5 6 (\->DIR)
  284. ;
  285.   CCD
  286. C$ 451 (CCD, \-> d)
  287. ::
  288.  AtUserStack
  289.  $ "Processing:\\010"
  290.  DISPSTATUS2
  291.  ZERO
  292.  DOVARS DUP1LAMBIND
  293.  LENCOMP
  294.  #1+_ONE_DO
  295.   1GETLAM INDEX@
  296.   NTHCOMPDROP
  297.   DUP ID>$ DISPROW2
  298.   DUP XEQRCL
  299.   ::
  300.    DUPTYPERRP? case2DROP
  301.    DUPTYPECSTR?
  302.    IT
  303.    ::
  304.     DUP DUPNULL$?
  305.     ITE
  306.      DROPZERO
  307.      CAR$
  308.     CHR>#
  309.     40 #=casedrop
  310.      ROMPTR 4D2 1 (\->RPL)
  311.     42 #<> ?SEMI
  312.     ROMPTR 4D2 4 (\->COD)
  313.     DROP
  314.    ;
  315.    SWAPROT #1+
  316.   ;
  317.  LOOP
  318.  ABND
  319.  UNCOERCE
  320.  ROMPTR 4C5 6 (\->DIR)
  321. ;
  322.   DAR
  323. C$ 626 (DAR,h \-> $)
  324. ::
  325.  CK1NoBlame
  326.  DUPTYPEHSTR?
  327.  NcaseTYPEERR '
  328.  :: 8
  329.   #1+_ONE_DO
  330.    INDEX@ ClrUserFlag
  331.   LOOP
  332.  ;
  333.  ' ROMPTR 4D2 7 (DA1)
  334.  ROMPTR@ NOTcase
  335.  PTR 11056
  336.  OVER
  337.  ' NULLLAM DUPTWO DOBIND
  338.  EVAL DUPDUP BlankDA12
  339.  $ "Press <ENTER> to see next line"
  340.  DispCoord1
  341.  BEGIN
  342.   2GETLAM EvalNoCK
  343.   SWAP
  344.   ABUFF 0 8 131 64
  345.   SUBGROB
  346.   ABUFF ZEROZERO GROB!
  347.   DISPROW7
  348.   WaitForKey
  349.   DROP 45 #=casedrop
  350.   :: 1GETABND EVAL
  351.      ABORT
  352.   ;
  353.   25 #<>
  354.  UNTIL
  355.  1GETABND EVAL
  356.  OVER HXS>$ $ "From: "
  357.  !insert$ NEWLINE$&$
  358.  OVER HXS>$ $ "To  : "
  359.  !insert$ !append$
  360.  DISPSTATUS2
  361.  ROMPTR 4D2 8 (DAXY)
  362.  SWAP HXS>$ $ "* "
  363.  !insert$ NEWLINE$&$
  364.  !insert$
  365. ;
  366.   DBG
  367. "(DBG, \-> )
  368. ::
  369.  63 TestUserFlag
  370.  1LAMBIND
  371.  63 SetUserFlag
  372.  ROMPTR 4D2 13 (DispStack)
  373.  WaitForKey DROP
  374.  63 1GETABND
  375.  ITE_DROP ClrUserFlag
  376.  25 (kcEnter) #= ?SEMI
  377.  AtUserStack ABORT
  378. ;"
  379.   Types
  380. "(Types, \-> )
  381. ::
  382.  AtUserStack BlankDA2
  383.  13 18
  384.  GROB 398 320008600020003D00003E6E0EE4400776AE500805100801AA082011051AAA50083510080D6A0E688007366E5A2825100809AA082440041AA22A283D00003EAE0E20110716A2000000000000000000000000003208312118172E0AE85402726E2800215B1822510A24011512A42400117518227D0E64880732A4220801511822590824440512A47808075118125E082811151E64000000000000000000000000007C28300008359A3EE4C6037EA6428825200805B21224440512A4724830000815F21E6444033644122825200805D21824440512A47C8830100837921E2CD6031EAE000000000000000000000000007C38321E09351D0CE85D067EAE4A0825118A05151224451112A87C18371D8A121D0E64CD01364E482025198A05151A24451112A27E18357E09057D0E2855161EAE0000000000000000000000000056301656893A000EE8DD037EAE52282151090F100824451512A872283221091A0004644515364E42282421090F100224451512A8463823268B0A000228DD031EAE000000000000000000000000007C6815568B33370EE443077EAA144825510A05550A24450112AA76C817228B13370E644303364E444825548805510A24450112A87C6815538B05510E2C53071EA8
  385.  XYGROBDISP
  386.  SetDA2OKTemp
  387. ;"
  388.   tEVAL
  389. C$ 179 (tEVAL,o \-> ?)
  390. ::
  391.  CK1NoBlame
  392.  GARBAGE
  393.  CLKTICKS 1LAMBIND
  394.  xEVAL
  395.  CLKTICKS 1GETABND
  396.  bit- HXS>%
  397.  % 8.192 DUPUNROT %/
  398.  SWAP %- %3 RNDXY
  399.  UNIT
  400.   %1 CHR m $ "s" umP
  401.   umEND
  402.  ;
  403.  UM>U
  404. ;
  405.   MON
  406. "(MON, \-> ?)
  407. ::
  408.  AtUserStack
  409.  {
  410.   18 16 17 11 49 44
  411.   39 34 29 28 27 26
  412.  }
  413.  {
  414.   #1     #FFFFF
  415.   #10    #FFFF0
  416.   #100   #FFF00
  417.   #1000  #FF000
  418.   #10000 #F0000
  419.   #70    #FFF90
  420.  }
  421.  ' NULLLAM DUPTWO DOBIND
  422.  NULL$ #142 EXPAND
  423.  ID MONpar
  424.  DUPTYPEHSTR? ?SKIP
  425.  ::
  426.   DROP' ID MONpar
  427.   HXS 5 00100
  428.   OVER STO EVAL
  429.  ;
  430.  BEGIN
  431.   BEGIN
  432.    CODE
  433.     GOSBVL =SAVPTR
  434.     A=DAT1 A
  435.     A=A+CON A,10
  436.     R0=A
  437.     D0=A
  438.     A=DAT0 A
  439.     R1=A
  440.     D1=D1+ 5
  441.     A=DAT1 A
  442.     D1=A
  443.     D1=D1+ 10
  444.     LC(5)  6
  445.     B=C    A
  446. LBEDB6
  447.     LC(5)  4
  448.     D=C    A
  449.     A=R0
  450.     D0=A
  451.     D1=D1+ 8
  452. LBEDC8
  453.     GOSUB  LBEE33
  454.     D1=D1- 2
  455.     D=D-1  A
  456.     GONC   LBEDC8
  457.     D1=D1+ 12
  458.     LCASC  ':'
  459.     DAT1=C B
  460.     D1=D1+ 2
  461.     LC(5)  #F
  462.     D=C    A
  463.     D0=D0- 5
  464.     A=DAT0 A
  465.     D0=A
  466. LBEDF3
  467.     GOSUB  LBEE33
  468.     D1=D1+ 2
  469.     D=D-1  A
  470.     GONC   LBEDF3
  471.     LC(2)  #A
  472.     DAT1=C B
  473.     D1=D1+ 2
  474.     A=R0
  475.     D0=A
  476.     A=DAT0 A
  477.     A=A+CON A,16
  478.     DAT0=A A
  479.     B=B-1  A
  480.     GONC   LBEDB6
  481.     A=R0
  482.     D0=A
  483.     A=R1
  484.     DAT0=A A
  485.     GOVLNG =GETPTRLOOP
  486. LBEE33
  487.     C=0    B
  488.     C=DAT0 1
  489.     LAASC  '0'
  490.     C=C+A  B
  491.     LAASC  '9'
  492.     ?C<=A  B
  493.     GOYES  LBEE5A
  494.     LA(2)  7
  495.     C=C+A  B
  496. LBEE5A
  497.     DAT1=C B
  498.     D0=D0+ 1
  499.     RTN
  500.    ENDCODE
  501.    OVER 1 7 Disp5x7
  502.    ?ATTNQUIT
  503.    GETTOUCH
  504.   UNTIL
  505.   H/W>KeyCode
  506.   1GETLAM 2GETLAM ROT
  507.   #=POSCOMP NTHELCOMP
  508.   ITE
  509.    CODE
  510.     GOSBVL =POP#
  511.     GOSBVL =SAVPTR
  512.     C=DAT1 A
  513.     CD1EX
  514.     D1=D1+ 10
  515.     C=DAT1 A
  516.     C=C+A  A
  517.     DAT1=C A
  518.     GOVLNG =GPPushFLoop
  519.    ENDCODE
  520.    TRUE
  521.  UNTIL
  522.  DROP ABND
  523. ;"
  524.   PBYTES
  525. "(PBYTES,% \-> %')
  526. ASSEMBLE
  527. PORTDUMP    EQU #21922
  528. RPL
  529. ::
  530.  CK1NoBlame CKREAL
  531.  COERCE
  532.  PORTDUMP
  533.  DUP#0=csedrp
  534.  :: DROP %0
  535.  ;
  536.  ZEROSWAP
  537.  ZERO_DO
  538.   SWAP OSIZE #+
  539.  LOOP
  540.  SWAPDROP
  541.  UNCOERCE %2 %/
  542. ;"
  543.   FIXIT
  544. C$ 369 (FIXIT,$ \-> o)
  545. ::
  546.  CK1NoBlame
  547.  DUPTYPECSTR?
  548.  NcaseTYPEERR
  549.  DUPONE 7 SUB$
  550.  $ "HPHP48-" EQUAL
  551.  NcaseSIZEERR
  552.  DUPLEN$ 8 #- #2*
  553.  SWAP GARBAGE
  554.  CODE
  555.   C=DAT1 A
  556.   CD1EX
  557.   D1=D1+ 10
  558.   D1=D1+ 16
  559.   CD1EX
  560.   DAT1=C A
  561.   LOOP
  562.  ENDCODE
  563.  DUP XEQTYPE %27 %=
  564.  casedrop
  565.  ::
  566.   # 304 ERRORSTO
  567.   ERRJMP
  568.  ;
  569.  DUP OSIZE ROT #>
  570.  casedrop
  571.  ::
  572.   # 12C ERRORSTO
  573.   ERRJMP
  574.  ;
  575.  AtUserStack
  576.  TOTEMPOB
  577. ;
  578.   GetKO
  579. C$ 130 (GtKO, \-> o %)
  580. ::
  581.  AtUserStack BlankDA2
  582.  $ "Perform a keystroke\\031"
  583.  DISPROW5
  584.  WaitForKey
  585.  2DUP Key>U/SKeyOb
  586.  UNROT CodePl>%rc.p
  587. ;
  588.   Strip
  589. "(Strip,o \-> o')
  590. ::
  591.  CK1NoBlame
  592.  '
  593.  ::
  594.   ?ATTNQUIT
  595.   DUPTYPELIST? case
  596.   :: 1GETLAM EVAL {}N
  597.   ;
  598.   DUPTYPESYMB? case
  599.   :: 1GETLAM EVAL SYMBN
  600.   ;
  601.   DUPTYPECOL? NOT?SEMI
  602.   DUPLENCOMP #0=?SEMI
  603.   DUP CARCOMP
  604.   ' x<< EQ IT CDRCOMP
  605.   DUP DUPLENCOMP
  606.   NTHELCOMP NOT?SEMI
  607.   ' x>> EQ IT
  608.   ::
  609.    DUPLENCOMP #1-
  610.    ONESWAP SUBCOMP
  611.   ;
  612.   1GETLAM EVAL ::N
  613.  ;
  614.  DUP
  615.  '
  616.  ::
  617.   INNERDUP
  618.   DUP#0=csDROP
  619.   ZERO_DO
  620.    ROLL
  621.    BEGIN
  622.     { xENDTIC
  623.       xIF xUNTIL
  624.     }
  625.     OVER ' EQ POSCOMP
  626.     #0<>
  627.    WHILE
  628.    ::
  629.     DROP
  630.     ISTOP@
  631.     #1-DUP ISTOPSTO
  632.     INDEX@
  633.     OVER#=case DROP
  634.     ROLL
  635.    ;
  636.    REPEAT
  637.    INHARDROM?
  638.    ?SKIP 2GETEVAL
  639.    ISTOP@
  640.   LOOP
  641.  ;
  642.  ' NULLLAM DUPTWO
  643.  DOBIND EVAL ABND
  644. ;"
  645.   F&R
  646. "(F&R,$ $f $r \-> $')
  647. ::
  648.  CK3NOLASTWD
  649.  0LASTOWDOB!
  650.  CK&DISPATCH1
  651.  # 333 ($$$)
  652.  ::
  653.   UNROT 2DUP 1 POS$
  654.   DUP#0=case
  655.   :: 2DROP SWAPDROP
  656.   ;
  657.   SWAP DUPLEN$
  658.   5UNROLL 5UNROLL
  659.   NULL$ UNROT
  660.   BEGIN
  661.    2DUP 7PICK #+
  662.    OVERLEN$ SUB$
  663.    5UNROLL
  664.    #1-1SWAP SUB$ &$
  665.    OVER &$ ROTDUP
  666.    6PICK 1 POS$
  667.    DUP#0=
  668.   UNTIL
  669.   DROP &$
  670.   4UNROLL3DROP
  671.  ;
  672. ;"
  673.   DIFF
  674. "(DIFF,{} {} \-> {}')
  675. ASSEMBLE
  676. Fast EQU 1
  677. RPL
  678. ::
  679.  0LASTOWDOB!
  680.  CK2NOLASTWD
  681.  CK&DISPATCH1 
  682.  #55 ({} {})
  683.  ::
  684.   DUPNULL{}? caseDROP
  685.   SWAP DUPNULL{}?
  686.   case SWAPDROP
  687.   INNERDUP #2+ROLL
  688.   ZERO ROT
  689.   ZERO_DO
  690.    DUP #3+PICK
  691.    3PICKSWAP
  692.    ASSEMBLE
  693.     IFEQ Fast
  694.      CON(5) =EQUALPOSCOMP
  695.     ELSE
  696.      CON(5) =DOCODE
  697.      REL(5) len
  698.      INCLUDE EPC
  699. len
  700.     ENDIF
  701.    RPL
  702.    #0=ITE
  703.     #1+
  704.    :: DUP #3+ ROLLDROP
  705.    ;
  706.   LOOP
  707.   SWAPDROP {}N
  708.  ;
  709. ;"
  710.   EPC
  711. "
  712. * EqualPosComp
  713.  A=DAT1 A
  714.  R1=A
  715.  AD1EX
  716.  C=DAT1 A
  717.  R2=C
  718.  D1=A
  719.  D1=D1+ 5
  720.  D=D+1  A
  721.  A=DAT1 A
  722.  D1=D1+ 5
  723.  D=D+1  A
  724.  GOSBVL =SAVPTR
  725.  D0=A
  726.  D0=D0+ 5
  727.  C=0    A
  728.  GONC   EqLpEn
  729.  
  730. NotFnd
  731.  A=0    A
  732.  R0=A
  733.  GOTO   P#Lp
  734.  
  735. EqLp
  736.  GOSBVL =SKIPOB
  737.  C=R0.F A
  738. EqLpEn
  739.  C=C+1  A
  740.  R0=C.F A
  741.  A=DAT0 A
  742.  LC(5)  =SEMI
  743.  ?C=A   A
  744.  GOYES  NotFnd
  745.  D1=A
  746.  A=DAT1 A
  747.  LC(5)  =PRLG
  748.  ?C#A   A
  749.  GOYES  InDir
  750.  AD0EX
  751.  D0=A
  752.  D1=A
  753.  A=DAT1 A
  754.  
  755. InDir
  756.  C=R2.F A
  757.  ?C#A   A
  758.  GOYES  EqLp
  759.  
  760.  CD0EX
  761.  R3=C.F A
  762.  A=R1.F A
  763.  D0=A
  764.  B=A    A
  765.  GOSBVL =SKIPOB
  766.  C=B    A
  767.  CD1EX
  768.  D=C    A
  769.  CD0EX
  770.  C=C-B  A
  771.  B=C    A
  772.  GOSBVL =SKIPOB
  773.  C=D    A
  774.  A=C    A
  775.  AD0EX
  776.  C=A-C  A
  777.  ?B=C   A
  778.  GOYES  EqLen
  779.  
  780. NotEq
  781.  P=     0
  782.  C=R3.F A
  783.  D0=C
  784.  GOTO   EqLp
  785.  
  786. EqLen
  787.  BSR    A
  788.  P=C    0
  789.  
  790. Ck16
  791.  B=B-1  A
  792.  GOC    CkP
  793.  A=DAT0 W
  794.  C=DAT1 W
  795.  ?C#A   W
  796.  GOYES  NotEq
  797.  D0=D0+ 16
  798.  D1=D1+ 16
  799.  GONC   Ck16
  800.  
  801. CkP
  802.  P=P-1
  803.  GOC    IsEq
  804.  A=DAT0 WP
  805.  C=DAT1 WP
  806.  ?C#A   WP
  807.  GOYES  NotEq
  808.  
  809. IsEq
  810.  P=      0
  811. P#Lp
  812.  GOVLNG  =PUSH#LOOP"
  813.   Time
  814. "(Time, \-> )
  815. ASSEMBLE
  816. SetDA1NoCh EQU #393D3
  817. RPL
  818. ::
  819.  AtUserStack
  820.  #FFFFF DUPDUP
  821.  '
  822.  ::
  823.   SWAP 10 #/
  824.   ROTSWAP #1+
  825.   1GETSWAP
  826.   NTHCOMPDROP
  827.   HARDBUFF 3PICK 28
  828.   GROB!
  829.   SWAP#1+
  830.   1GETSWAP
  831.   NTHCOMPDROP
  832.   HARDBUFF
  833.   ROT 11 #+ 28
  834.   GROB!
  835.  ;
  836.  {
  837.   GROB 42 E0000A0000CF00CF00303030303C303C3033303330F030F03030303030CF00CF00
  838.   GROB 42 E0000A000003000300C300C30003000300030003000300030003000300CF00CF00
  839.   GROB 42 E0000A0000CF00CF0030303030003000300F000F00C000C00030003000FF30FF30
  840.   GROB 42 E0000A0000CF00CF003030303000300030CF00CF000030003030303030CF00CF00
  841.   GROB 42 E0000A00000C000C000F000F00CC00CC003C003C00FF30FF300C000C000C000C00
  842.   GROB 42 E0000A0000FF30FF3030003000FF00FF00003000300030003030303030CF00CF00
  843.   GROB 42 E0000A00000F000F00C000C00030003000FF00FF003030303030303030CF00CF00
  844.   GROB 42 E0000A0000FF30FF30003000300C000C0003000300C000C000C000C000C000C000
  845.   GROB 42 E0000A0000CF00CF003030303030303030CF00CF003030303030303030CF00CF00
  846.   GROB 42 E0000A0000CF00CF003030303030303030CF30CF30003000300C000C00C300C300
  847.  }
  848.  ' NULLLAM 5 NDUPN
  849.  DOBIND
  850.  BlankDA2
  851.  49 28
  852.  GROB 22 C000040000000060F0F060000060F0F060
  853.  78 3PICK3PICK
  854.  XYGROBDISP XYGROBDISP
  855.  BEGIN
  856.   GARBAGE
  857.   TOD DUP %IP>#
  858.   3GETLAM OVER#=
  859.   ITE_DROP
  860.   :: DUP 3PUTLAM
  861.      26 2GETEVAL
  862.   ;
  863.   %FP %10* %10*
  864.   DUP %IP>#
  865.   4GETLAM OVER#=
  866.   ITE_DROP
  867.   :: DUP 4PUTLAM
  868.      55 2GETEVAL
  869.   ;
  870.   %FP %10* %10* %IP>#
  871.   5GETLAM OVER#=
  872.   ITE_DROP
  873.   :: DUP 5PUTLAM
  874.      84 2GETEVAL
  875.   ;
  876.   ?ATTNQUIT
  877.   GETTOUCH
  878.  UNTIL
  879.  DROP
  880.  ABND
  881.  SetDA1NoCh
  882.  SetDA3NoCh
  883. ;"
  884.   LBLD
  885. C$ 2936 (LBLD, \-> ?)
  886. ASSEMBLE
  887. Repeater EQU #51735
  888. RPL
  889. ::
  890.  AtUserStack
  891.  POLSaveUI
  892.  ERRSET
  893.  ::
  894.   FALSE 4 11 FALSE'
  895.   ::
  896.    5GETLAM 21 #+
  897.    6GETLAM 55 #+OVER
  898.    44 #+OVER
  899.    2DUP PIXON?
  900.    IT 2SWAP
  901.    PIXON PIXOFF
  902.   ;
  903.   '
  904.   ::
  905.    7GETLAM IT
  906.    :: 3GETLAM EVAL
  907.    ;
  908.    GROB 12 400004000090606090
  909.    TOTEMPOB
  910.    5GETLAM 21 #+
  911.    6GETLAM 55 #+
  912.    PIXON? ?SKIP INVGROB
  913.    HARDBUFF
  914.    5GETLAM
  915.    #1- 5 #* #1+
  916.    6GETLAM
  917.    #1- 5 #* 11 #+
  918.    GROB!
  919.   ;
  920.   '
  921.   ::
  922.    4 4 MAKEGROB
  923.    5GETLAM 21 #+
  924.    6GETLAM 55 #+
  925.    PIXON? IT INVGROB
  926.    HARDBUFF
  927.    5GETLAM
  928.    #1- 5 #* #1+
  929.    6GETLAM
  930.    #1- 5 #* 11 #+
  931.    GROB!
  932.   ;
  933.   ' NULLLAM 7 NDUPN
  934.   DOBIND
  935.   ClrDA1IsStat
  936.   RECLAIMDISP
  937.   3 0
  938.   $ "HP-48 GRAPHIC MENU LABEL MAKER"
  939.   $>grob XYGROBDISP
  940.   110 $ "EXIT"
  941.   MakeStdLabel
  942.   88 $ "\\->STK"
  943.   MakeStdLabel
  944.   66 8 21 MAKEGROB
  945.   INVGROB
  946.   44 $ "SBGR"
  947.   MakeStdLabel
  948.   0 $ "TOG"
  949.   MakeStdLabel
  950.   TURNMENUOFF
  951.   5 ZERO_DO
  952.    56 SWAP XYGROBDISP
  953.   LOOP
  954.   45 ZERO_DO
  955.    INDEX@ #10+
  956.    110 ZERO_DO
  957.     INDEX@ OVER PIXON
  958.     5
  959.    +LOOP
  960.    DROP 5
  961.   +LOOP
  962.   2GETEVAL
  963.   '
  964.   ::
  965.    $ "Y: "
  966.    6GETLAM #>$ &$
  967.    MakeInvLabel
  968.    HARDBUFF
  969.    109 36
  970.    $ "X: "
  971.    5GETLAM #>$ &$
  972.    MakeInvLabel
  973.    HARDBUFF
  974.    4PICK 16
  975.    GROB! GROB!
  976.   ;
  977.   '
  978.   ::
  979.    1 #=casedrop
  980.    ::
  981.     11 ?CaseKeyDef
  982.     ::
  983.      TakeOver
  984.      Repeater 11
  985.      ::
  986.       1GETLAM EVAL
  987.       6GETLAM #1-
  988.       DUP#0=IT
  989.       :: DROP 8
  990.       ;
  991.       6PUTLAM 2GETEVAL
  992.      ;
  993.     ;
  994.     16 ?CaseKeyDef
  995.     ::
  996.      TakeOver
  997.      Repeater 16
  998.      ::
  999.       1GETLAM EVAL
  1000.       5GETLAM #1-
  1001.       DUP#0=IT
  1002.       :: DROP 21
  1003.       ;
  1004.       5PUTLAM 2GETEVAL
  1005.      ;
  1006.     ;
  1007.     17 ?CaseKeyDef
  1008.     ::
  1009.      TakeOver
  1010.      Repeater 17
  1011.      ::
  1012.       1GETLAM EVAL
  1013.       6GETLAM #1+DUP
  1014.       9 #= IT DROPONE
  1015.       6PUTLAM 2GETEVAL
  1016.      ;
  1017.     ;
  1018.     18 ?CaseKeyDef
  1019.     ::
  1020.      TakeOver
  1021.      Repeater 18
  1022.      ::
  1023.       1GETLAM EVAL
  1024.       5GETLAM #1+DUP
  1025.       22 #= IT DROPONE
  1026.       5PUTLAM 2GETEVAL
  1027.      ;
  1028.     ;
  1029.     25 ?CaseKeyDef
  1030.     ::
  1031.      TakeOver
  1032.      7GETLAM ?SKIP
  1033.      :: 3GETLAM EVAL
  1034.      ;
  1035.      2GETEVAL
  1036.     ;
  1037.     1 ?CaseKeyDef
  1038.     ::
  1039.      TakeOver
  1040.      0 56 $ "TOG"
  1041.      7GETLAM NOT
  1042.      DUP 7PUTLAM
  1043.      Box/StdLabel
  1044.      XYGROBDISP
  1045.      2GETEVAL
  1046.     ;
  1047.     3 ?CaseKeyDef
  1048.     ::
  1049.      TakeOver
  1050.      HARDBUFF
  1051.      22 56 OVER
  1052.      5GETLAM #+OVER
  1053.      6GETLAM #+
  1054.      SUBGROB
  1055.      DUP TOTEMPOB
  1056.      INVGROB
  1057.      $ "Inv" >TAG
  1058.      SWAP
  1059.      $ "Reg" >TAG
  1060.     ;
  1061.     5 ?CaseKeyDef
  1062.     ::
  1063.      TakeOver
  1064.      HARDBUFF
  1065.      22 56 43 64
  1066.      SUBGROB
  1067.      DUP TOTEMPOB
  1068.      INVGROB
  1069.      $ "Inv" >TAG
  1070.      SWAP
  1071.      $ "Reg" >TAG
  1072.     ;
  1073.     6 ?CaseKeyDef
  1074.     ::
  1075.      TakeOver
  1076.      TRUE 4PUTLAM
  1077.     ;
  1078.     45 ?CaseKeyDef
  1079.     ::
  1080.      TakeOver
  1081.      TRUE 4PUTLAM
  1082.     ;
  1083.     40 #=casedrpfls
  1084.     DROPDEADTRUE
  1085.    ;
  1086.    3 #=casedrop
  1087.    ::
  1088.     45 #=casedrpfls
  1089.     DROPDEADTRUE
  1090.    ;
  1091.    2DROP 'DoBadKeyT
  1092.   ;
  1093.   TrueTrue FALSE
  1094.   ONEFALSE' 4GETLAM
  1095.   'ERRJMP
  1096.   POLSetUI
  1097.   POLKeyUI
  1098.   ABND
  1099.   TURNMENUON
  1100.   RECLAIMDISP
  1101.   ClrDAsOK
  1102.  ;
  1103.  ERRTRAP
  1104.   POLResUI&Err
  1105.  POLRestoreUI
  1106. ;
  1107. END
  1108.